home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
pull5xa.arc
/
PULLSHEL.ARC
/
PULLDATA.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-01-10
|
11KB
|
318 lines
{ =========================================================================== }
{ PullData.pas - User Statistics for data-entry windows. ver 5.X, 01-07-89 }
{ }
{ This file contains all the data to configure the data-entry fields in }
{ data windows or work windows. }
{ Copyright (c) 1987-1989 James H. LeMay, All rights reserved. }
{ =========================================================================== }
{ R-,S-,I-,D-,T-,F-,V-,B-,N-,L+ } { TP4 directives }
{$A-,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-} { TP5 directives }
{$define UseMsgLineCode }
UNIT PullData;
INTERFACE
uses
Crt,Qwik,Strs,Wndw,Pull,PullStat;
{ ================ Set up variables for data windows here: ================== }
{ Place your variables names here to interface with the menus. }
{ Careful! -- there's NO type checking for parameters in Transfer. You MUST }
{ be certain case statement, DataWndw, and TypeOfData all match. Be }
{ especially careful of string lengths that are too long. They can be no }
{ longer than DataStrSize. }
{ --------------------------------------------------------------------------- }
const
aByte: byte = 100;
aInteger: integer = 200;
type
{ Work window data entry names. }
DataEntryNames = (NoDE,aIntegerDE);
var
DataEntryOattr, { Output attribute }
DataEntryIattr, { Input attribute }
DataWndwIattr, { Input attribute }
DataWndwOattr, { Output attribute }
DataWndwBattr: byte; { Border attribute }
DataWndwBrdr: Borders;
IMPLEMENTATION
{ ================ Set up your Error Message Lines here: ================== }
{ Error Messages are used for indicating that data entry was invalid or out }
{ of range. ErrMsgLine[1] is reserved for custom error messages that you }
{ can create at runtime. Messages up to InvalidEM are reserved and must }
{ match those in PULL.PAS. }
{ ------------------------------------------------------------------------- }
type
ErrMsgNames = (NoEM,UserEM,InvalidEM,MyEM);
{$ifdef UseMsgLineCode }
procedure GetErrMsgs;
begin
AutoNumLock := false; { If true, turns on NumLock on with data entry }
CapsLockCol := 41; { First column for ' CAPS NUM SCROLL ' on MsgLine. }
ErrMsgLine[ord(InvalidEM)]:=' Invalid entry. ESC-acknowledge';
ErrMsgLine[ord(MyEM)] :=' This indicates an error. ESC-acknowledge';
end;
{$endif UseMsgLineCode }
procedure MakeErrMsg (Low,High: longint);
begin
{$ifdef UseMsgLineCode }
DataPad.ErrMsg := ord(UserEM);
ErrMsgLine[ord(UserEM)] :=
'Range: '+StrL(Low)+' to '+StrL(High)+'. Press ESC';
{$endif }
end;
{ ====================== Data Entry Range Checking ========================== }
{ These procedures are completely defined by the user. They may not even be }
{ necessary if the string entered is satisfactory as a valid number. The }
{ calls must be forced to FAR because they are called indirectly. }
{ "Translate" can alter each key from the keyboard before it gets evaluated. }
{ "Verify" will check the range or even completely alter the entire string. }
{ --------------------------------------------------------------------------- }
{ -------------------- Data Window Data Entry Checking ---------------------- }
{$F+}
procedure CheckAbyte;
begin
with DataPad do
if ((Bdata<20) or (Bdata>50)) then
MakeErrMsg (20,50);
end;
{ -------------------- Work Window Data Entry Checking ---------------------- }
procedure TranslateCase;
begin
if not ExtKey then
Key := upcase(Key); { Simple upper case translation }
end;
procedure VerifyAinteger;
begin
with DataPad do
if ((Idata=0) or (Idata>200)) then
MakeErrMsg (1,200);
end;
{$F-}
{ ======================== GetUserDataEntry ================================= }
{ The major configurations for all menus go here. The program first clears }
{ all RECORD values to $00. The values below will set new values. Therefore, }
{ setting RECORD values to "false", nil, or the like is not necessary. }
{ --------------------------------------------------------------------------- }
{ Code saving utilities: }
procedure GetDataWndw (Index: word);
begin
DWI := Index;
TopDataWndw := DataWndw^[DWI];
end;
procedure SaveDataWndw;
begin
DataWndw^[DWI] := TopDataWndw;
end;
procedure GetDataEntry (Index: word);
begin
DEI := Index;
TopEntry := DataEntry^[DEI];
end;
procedure SaveDataEntry;
begin
DataEntry^[DEI] := TopEntry;
end;
procedure GetDataEntryStats;
begin
{ ------------- Set up your PULL-DOWN Data Windows here: ------------------ }
{ Justification will default with numbers right justified and string to }
{ the left if none is specified. }
with TopDataWndw,TopDataWndw.Entry do
begin
GetDataWndw (ord(aByteDW)); { Just gets cleared TopDataWndw }
VarAddr := @aByte;
{ TypeOfData := Bytes; } { This is the default }
Field := 3;
{ JustifyOutput := Right; } { This is the default }
{ MsgLineNum := ord(DE_ML); } { This is the default }
{ HelpWndwNum := ord(DataWndwHW); } { This is the default }
SaveDataWndw; { Saves it in the heap }
end; { with }
{ ------------------------ Work Window Data Entry ------------------------- }
AutoTab := true; { After entry, tabs to next one in sequence }
with DataPad do
if QvideoMode=Mono then
Hattr := LightGrayBG
else Hattr := White+CyanBG; { Optional Attribute of Data Entry hilite }
{ Use SameAttr if not desired }
with TopEntry do
begin
GetDataEntry (ord(aIntegerDE));
VarAddr := @aInteger;
TypeOfData := Integers;
Row := 2;
Col := 11;
Field := 4;
MaxField := 3;
CheckRangeProc := @VerifyAinteger;
{ MsgLineNum := ord(DE_ML); } { This is the default }
{ HelpWndwNum := ord(DataWndwHW); } { This is the default }
SaveDataEntry;
end;
end; { procedure GetDataEntryStats }
{ =================== Data Entry Initialization Code ======================== }
{ The following code initializes all of the stats for the data entry windows }
{ and the work window data entry fields. There is no need to edit this }
{ Except for the default colors in SetDefaultColors. }
{ --------------------------------------------------------------------------- }
procedure AllocateHeap;
begin
if HeapOK (sizeof(DataWndws)) then
GetMem (DataWndw,SizeOf(DataWndws));
fillchar (DataWndw^,SizeOf(DataWndws),0);
if HeapOK (sizeof(DataEntries)) then
GetMem (DataEntry,SizeOf(DataEntries));
fillchar (DataEntry^,SizeOf(DataEntries),0);
end;
procedure SetDefaultColors;
begin
{ ------------------ Set up your colors and borders here: ---------------- }
if QvideoMode=Mono then
begin
DataEntryIattr := LightGray; { Input attribute }
DataEntryOattr := White; { Output attribute }
DataWndwIattr := White; { Input attribute }
DataWndwOattr := LightGrayBG; { Output attribute }
end
else
begin
DataEntryIattr := Yellow+MagentaBG; { Input attribute }
DataEntryOattr := Black+LightGrayBG; { Output attribute }
DataWndwIattr := Black+BrownBG; { Input attribute }
DataWndwOattr := Yellow+BlackBG; { Output attribute }
end;
DataWndwBattr := Black+BrownBG; { Border attribute }
DataWndwBrdr := HdoubleBrdr;
end;
procedure InitDataColors;
var i: word;
begin
for i:=1 to NumOfDataWndws do
with TopDataWndw,TopDataWndw.Entry do
begin
GetDataWndw (i);
Iattr := DataWndwIattr; { Input attribute }
Oattr := DataWndwOattr; { Output attribute }
Battr := DataWndwBattr; { Border attribute }
SaveDataWndw;
end;
for i:=1 to NumOfDataEntries do
with TopEntry do
begin
GetDataEntry (i);
Iattr := DataEntryIattr; { Input attribute }
Oattr := DataEntryOattr; { Output attribute }
SaveDataEntry;
end;
end;
function GetJustify (Justify: DirType; TOD: TypeOfDataType): DirType;
begin
if Justify=NoDir then
begin
if TOD<=UserNums then
GetJustify := Right { for nums }
else GetJustify := Left; { for chars and strings }
end
else GetJustify:=Justify;
end;
function GetSetName (SN: SetNames; TOD: TypeOfDataType): SetNames;
begin
if SN=NoSet then
case TOD of
Bytes,Words: GetSetName := UnsignedSet;
ShortInts..LongInts: GetSetName := SignedSet;
Reals: GetSetName := RealSet;
else
GetSetName := CharSet;
end
else GetSetName:=SN;
end;
procedure InitDataDefaults;
var i: word;
begin
for i:=1 to NumOfDataWndws do
with TopDataWndw,TopDataWndw.Entry do
begin
GetDataWndw (i);
Border := DataWndwBrdr;
SetName := GetSetName (SetName,TypeOfData);
Row := 1;
Col := 2;
if MaxField=0 then
MaxField := Field;
JustifyOutput := GetJustify (JustifyOutput,TypeOfData);
if MsgLineNum=0 then
MsgLineNum := ord(DW_ML);
if HelpWndwNum=0 then
HelpWndwNum := ord(DataWndwHW);
SaveDataWndw;
end;
for i:=1 to NumOfDataEntries do
with TopEntry do
begin
GetDataEntry (i);
SetName := GetSetName (SetName,TypeOfData);
if MaxField=0 then
MaxField := Field;
JustifyOutput := GetJustify (JustifyOutput,TypeOfData);
if MsgLineNum=0 then
MsgLineNum := ord(DE_ML);
if HelpWndwNum=0 then
HelpWndwNum := ord(DataWndwHW);
SaveDataEntry;
end;
end;
BEGIN
AllocateHeap;
SetDefaultColors;
InitDataColors;
{$ifdef UseMsgLineCode }
GetErrMsgs;
{$endif }
GetDataEntryStats;
InitDataDefaults;
END.